Attribute VB_Name = "ModSet"
'Declare Main

Public iSockets As Integer
Public iSocketsFree(SockMax) As Boolean
Public port As Long
Public durasi(1 To ClientMax) As Date
Public durasi_disc(1 To ClientMax) As Date
Public biaya(1 To ClientMax) As Single
Public biaya_disc(1 To ClientMax) As Single
Public total(1 To ClientMax) As Single
Public disc_mulai(1 To ClientMax) As Date
Public awal_personal As Long
Public awal_pelajar As Long
Public awal_member As Long
Public awal_game As Long
Public awal_ketik As Long
Public actbil
Public paydone As Integer
Public paystat As String
Public payst As String
Public optre As Node
Public depo As Long
Public interval As Long
Public intervalpel As Long
Public intervalmem As Long
Public intervalgam As Long
Public intervalmen As Long
Public settingharga As String
Public durasipay As String
Public timeinclient As String
Public harga_payfirst As Single
Public settinghargaawaljam As Long
Public atas(1 To ClientMax) As Long
Public ataspel(1 To ClientMax) As Long
Public atasmem(1 To ClientMax) As Long
Public atasgam(1 To ClientMax) As Long
Public atasmen(1 To ClientMax) As Long
Public bawah(1 To ClientMax) As Long
Public bawahpel(1 To ClientMax) As Long
Public bawahmem(1 To ClientMax) As Long
Public bawahgam(1 To ClientMax) As Long
Public bawahmen(1 To ClientMax) As Long
Public mulai_disc As Date
Public akhir_disc As Date
Public nama_warnet As String
Public alamat1 As String
Public alamat2 As String
Public slogan As String
Public jed As String
Public discok As Integer
'declare registry
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
'def error log
Public Const NamaLogFile = "Error.log"
'def registry
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const KEY_ALL_ACCESS = &HF003F
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEY = &H8
Public Const KEY_EXECUTE = &H20019
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_READ = &H20019
Public Const KEY_SET_VALUE = &H2
Public Const KEY_WRITE = &H20006
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_EXPAND_SZ = 2
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_RESOURCE_LIST = 8
Public Const REG_SZ = 1
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Public metu As Boolean
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong& Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long)
Private Declare Function SetWindowLong& Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Private Const WM_USER = &H400
Private Const PBM_SETBARCOLOR = (WM_USER + 9)
Private Const CCM_FIRST = &H2000
Private Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Private Type tagInitCommonControlsEx
   lngSize As Long
   lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib _
    "comctl32.dll" (iccex As tagInitCommonControlsEx) _
    As Boolean
Private Const ICC_USEREX_CLASSES = &H200
Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
 
Public conn As New ADODB.Connection
Public rec As New ADODB.Recordset
Public com As New ADODB.Command
Public Sub Main()
   On Error Resume Next
   Dim iccex As tagInitCommonControlsEx
   With iccex
       .lngSize = LenB(iccex)
       .lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   
If App.PrevInstance Then
MsgBox "Program masih aktif, lihat di taskbar, jika tidak ada, tekan tombol alt+tab untuk melihat program.", vbInformation, "App Found"

End
'Tampa ("black pearl server.exe")
End If
FrmLoading.Show
End Sub
Public Sub TulisError(ByVal KetErr, ByVal NomErr, ByVal ContErr As String, ByVal FrmErr As String)
    On Error GoTo jail
    Dim ErrNamLog As String
    Dim ErrP As String
    ErrP = App.path
    If Right(ErrP, 1) = "\" Then
        ErrP = ErrP
    Else
        ErrP = ErrP & "\"
    End If
    ErrNamLog = ErrP & NamaLogFile
    Open ErrNamLog For Append As #23
    Write #23, KetErr, NomErr, ContErr, FrmErr, Format(Now, "dd/mm/yy hh:mm:ss")
    Close #23
ExitEL:
    Exit Sub
jail:
    MsgBox Err.Description & vbCrLf & Err.Number, , "error" & " - Gagal Menulis Error Log"
    Resume ExitEL
End Sub

Public Sub PBcolor(PB As ProgressBar, Backcolor As Long, Forecolor As Long)
    SendMessage PB.hWnd, CCM_SETBKCOLOR, 0, ByVal Backcolor
    SendMessage PB.hWnd, PBM_SETBARCOLOR, 0, ByVal Forecolor
End Sub
Public Function FExists(OrigFile As String)
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    FExists = fs.FileExists(OrigFile)
End Function

Public Function DirExists(OrigFile As String)
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    DirExists = fs.FolderExists(OrigFile)
End Function

Public Sub RegSaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim keyHand As Long
Dim X As Long
    X = RegCreateKey(hKey, strPath, keyHand)
    X = RegSetValueEx(keyHand, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    X = RegCloseKey(keyHand)
End Sub

Sub TulisKey()
Dim subkey As String
    Call RegSaveString(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi & "\", "path", App.path & "\")
    Call RegSaveString(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi & "\", "versi", VersiAplikasi)
    Call RegSaveString(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi & "\", "penulis", Penulis)
    Call RegSaveString(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi & "\", "email", EmailPenulis)
    Call RegSaveString(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi & "\", "homepage", HomePage)
    pathdata = App.path & "\"
End Sub
Sub CekKey()
Dim X As Long
    X = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi, 0, KEY_READ, hregkey)
    If X <> 0 Then
        Call TulisKey
    Else
        Call AmbilKey
    End If
    X = RegCloseKey(hregkey)
End Sub
Sub AmbilKey()
Dim X As Long
    X = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\BLacKPeaRL\server\" & VersiAplikasi, 0, KEY_READ, hregkey)
    pathdata = GetRegistryValue(hregkey, "path")
End Sub
Public Function GetRegistryValue(ByVal hKey As Long, ByVal subkey_name As String) As String
Dim value As String
Dim Length As Long
Dim value_type As Long
    Length = 256
    value = Space$(Length)
    If RegQueryValueEx(hKey, subkey_name, 0&, value_type, ByVal value, Length) <> ERROR_SUCCESS Then
        value = "<blank>"
    Else
        value = Left$(value, Length - 1)
    End If
    GetRegistryValue = value
End Function

Public Function EncryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, E As Integer
Dim strBuff As String
    If Len(strPwd) Then
        For i = 1 To Len(strText)
            E = Asc(Mid$(strText, i, 1))
            E = E + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
            strBuff = strBuff & Chr$(E And &HFF)
        Next i
    Else
        strBuff = strText
    End If
    EncryptText = strBuff
End Function

Public Function DecryptText(strText As String, ByVal strPwd As String)
Dim i As Integer, D As Integer
Dim strBuff As String
    If Len(strPwd) Then
        For i = 1 To Len(strText)
            D = Asc(Mid$(strText, i, 1))
            D = D - Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
            strBuff = strBuff & Chr$(D And &HFF)
        Next i
    Else
        strBuff = strText
    End If
    DecryptText = strBuff
End Function
Public Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
'----------------------------------------------------------------------------
'Argument       :   Handlekey, Name of the Value in side the key
'Return Value   :   String
'Function       :   To fetch the value from a key in the Registry
'Comments       :   on Success , returns the Value else empty String
    '----------------------------------------------------------------------------
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
    
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
    
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
         ElseIf lValueType = REG_DWORD Then
           
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
            
        End If
    End If
End Function

Public Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim ret
    'Open  key
    RegOpenKey hKey, strPath, ret
    'Get content
    GetString = RegQueryStringValue(ret, strValue)
    'Close the key
    RegCloseKey ret
End Function

Public Sub SaveStringWORD(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim ret
    'Create a new key
    RegCreateKey hKey, strPath, ret
    'Set the key's value
    RegSetValueEx ret, strValue, 0, REG_DWORD, CLng(strData), 4
    'close the key
    RegCloseKey ret
End Sub

Public Sub SaveStringSZ(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim ret
    'Create a new key
    RegCreateKey hKey, strPath, ret
    'Set the key's value
    RegSetValueEx ret, strValue, 0, REG_SZ, ByVal strData, 1
    'close the key
    RegCloseKey ret
End Sub

Sub HapusForm(Optional ByVal FormNumber As Integer = -1)
 If FormNumber > -1 Then
  Unload Forms(FormNumber)
 Else
  Unload Forms(Forms.Count - 1)
 End If
End Sub

Public Function TranslucentForm(frm As Form, TranslucenceLevel As Byte) As Boolean
    SetWindowLong frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
    TranslucentForm = Err.LastDllError = 0
End Function


Public Function Tampa(ByVal pExe As String) As Long
On Error GoTo hell
    Dim proses As Object
    Dim inp As String
    inp = Trim(pExe)
    If Len(inp) > 0 Then
        For Each proses In GetObject("winmgmts:").ExecQuery _
            ("Select Name from Win32_process Where Name = '" & inp & "'")
            proses.Terminate
            Tampa = 1
            Exit Function
        Next proses
        Tampa = 2
    Else
        Tampa = 3
    End If
    Exit Function
hell:
    Tampa = Err.Number
End Function
Public Sub startcl()
  For i = 1 To ClientMax
        If FrmMain.MSFlexGrid.TextMatrix(i, 3) = "start" Then
            FrmMain.MSFlexGrid.TextMatrix(i, 4) = Format(Now, "hh:nn:ss")
            durasi(i) = CDate("00:00:00")
            durasi_disc(i) = CDate("00:00:00")
            mulai(i) = Now
            If Now >= mulai_disc Then
                disc_mulai(i) = Now
            Else
                disc_mulai(i) = mulai_disc
            End If
            
            'tulis aktifitas dalam db
            rec.Open "SELECT aktifitas.* FROM aktifitas WHERE aktifitas.no_client = " & i, conn, adOpenStatic, adLockOptimistic
            If Not rec.RecordCount = 0 Then
                rec(0) = i 'no client
                rec(3) = FrmMain.MSFlexGrid.TextMatrix(i, 2) 'user
                rec(1) = "aktif" 'status
                If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPersonal Then
                    rec(2) = "personal"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                    rec(2) = "member"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPayFirst Then
                    rec(2) = "payfirst"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPelajar Then
                    rec(2) = "pelajar"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setGame Then
                    rec(2) = "game"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setKetik Then
                    rec(2) = "ketik"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = "Operator" Then
                    rec(2) = "Operator"
                End If
                rec(4) = Now
                rec(5) = FrmMain.MSFlexGrid.TextMatrix(i, 9)
                rec(6) = timeinclient
                rec.Update
                rec.Close
            Else
                rec.AddNew
                rec(0) = i 'no client
                rec(3) = FrmMain.MSFlexGrid.TextMatrix(i, 2) 'user
                rec(1) = "aktif" 'status
                If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPersonal Then
                    rec(2) = "personal"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPelajar Then
                    rec(2) = "pelajar"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                    rec(2) = "member"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPayFirst Then
                    rec(2) = "payfirst"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setGame Then
                    rec(2) = "game"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setKetik Then
                    rec(2) = "ketik"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = "Operator" Then
                    rec(2) = "Operator"
                End If
                rec(4) = Now
                rec(5) = FrmMain.MSFlexGrid.TextMatrix(i, 9)
                rec(6) = timeinclient
                rec.Update
                rec.Close
            End If
            FrmMain.MSFlexGrid.TextMatrix(i, 3) = setAktif
        End If
    Next i
        Call updateon
        If FrmMain.chksound.value = 1 Then
        X = sndPlaySound(App.path & "\sound\start.wav", wFlags)
        End If
End Sub

Public Sub stopcl()
Dim regid As Single
 rec.Open "SELECT status.* FROM status", conn, adOpenStatic, adLockOptimistic
    If rec.RecordCount = 0 Then
    rec.Close
    Else
        rec.MoveFirst
        For i = 1 To rec.RecordCount
            regid = rec.RecordCount
            rec.MoveNext
        Next i
        rec.Close
        End If
    For i = 1 To ClientMax
        If FrmMain.MSFlexGrid.TextMatrix(i, 3) = "stop" Then
            'tulis laporan dalam db
              If FrmMain.MSFlexGrid.TextMatrix(i, 6) = "Waiting" Or FrmMain.MSFlexGrid.TextMatrix(i, 7) = "Operator" Then
              Else
            rec.Open "SELECT status.* FROM status", conn, adOpenStatic, adLockOptimistic
            rec.AddNew
            rec(0) = Val(regid) + 1
            rec(1) = Format(Date, "dd-mm-yyyy") 'tanggal
            rec(2) = i 'no client
            rec(3) = FrmMain.MSFlexGrid.TextMatrix(i, 2) 'user
            rec(4) = Format(mulai(i), "hh:nn:ss") ' mulai
            rec(5) = Format(Now, "hh:nn:ss") ' selesai
            rec(6) = Format(durasi(i), "hh:nn:ss") ' durasi
            rec(7) = total(i) 'total
            rec(8) = Format(Date, "mm") 'bulan
            rec(9) = Format(Date, "yyyy") 'tahun
            If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPersonal Then 'jenis
                rec(10) = "personal"
            ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPelajar Then
                rec(10) = "pelajar"
            ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                rec(10) = "member"
            With FrmPopup
            On Error Resume Next
            .lbl.Caption = "Status Client"
            .lbl1.Caption = "Cek client member, Sebaiknya langsung masukkan ke dalam laporan"
            .Visible = True
            End With
            ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPayFirst Then
                rec(10) = "payfirst"
            ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setGame Then
                rec(10) = "game"
            ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setKetik Then
                rec(10) = "ketik"
            End If
            rec(11) = "Belum Bayar"
             rec(12) = FrmMain.MSFlexGrid.TextMatrix(i, 9)
            rec.Update
            rec.Close
            If FrmMain.chksound.value = 1 Then
            X = sndPlaySound(App.path & "\sound\stop.wav", wFlags)
            End If
            End If
            'tulis aktifitas dalam db
            
            rec.Open "SELECT aktifitas.* FROM aktifitas WHERE aktifitas.no_client = " & i, conn, adOpenStatic, adLockOptimistic
            If Not rec.RecordCount = 0 Then
                rec(0) = i 'no client
                rec(3) = FrmMain.MSFlexGrid.TextMatrix(i, 2) 'user
                rec(1) = "bebas"
                rec(4) = Now
                rec(5) = FrmMain.MSFlexGrid.TextMatrix(i, 9)
                If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPersonal Then 'jenis
                    rec(2) = "personal"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPelajar Then
                    rec(2) = "pelajar"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                    rec(2) = "member"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setGame Then
                    rec(2) = "game"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setKetik Then
                    rec(2) = "ketik"
                End If
                rec.Update
                rec.Close
            Else
                rec.AddNew
                rec(0) = i 'no client
                rec(3) = FrmMain.MSFlexGrid.TextMatrix(i, 2) 'user
                rec(1) = "bebas"
                rec(4) = Now
                If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPersonal Then 'jenis
                    rec(2) = "personal"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                    rec(2) = "member"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPelajar Then
                    rec(2) = "pelajar"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setGame Then
                    rec(2) = "game"
                ElseIf FrmMain.MSFlexGrid.TextMatrix(i, 7) = setKetik Then
                    rec(2) = "ketik"
                End If
                rec.Update
                rec.Close
            End If
            
            If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setPayFirst Then
                'update deposit prepaid
                If FrmMain.MSFlexGrid.TextMatrix(i, 6) = "Waiting" Then
                Else
                rec.Open "SELECT prepaid.* FROM prepaid WHERE prepaid.user = '" & FrmMain.MSFlexGrid.TextMatrix(i, 2) & "' and prepaid.jenis='" & "Tidak Tetap" & "'", conn, adOpenStatic, adLockOptimistic
                If rec.RecordCount = 0 Then
                rec.Close
                Else
                rec.Delete
                rec.Close
                End If
                End If
            End If
            FrmMain.MSFlexGrid.TextMatrix(i, 3) = setBebas
      
        If FrmMain.MSFlexGrid.TextMatrix(i, 7) = setMember Then
                'update deposit member
                If FrmMain.MSFlexGrid.TextMatrix(i, 6) = "Waiting" Then
                Else
                rec.Open "SELECT member.* FROM member WHERE member.user = '" & FrmMain.MSFlexGrid.TextMatrix(i, 2) & "' ", conn, adOpenStatic, adLockOptimistic
                If Not rec.RecordCount = 0 Then
                    rec(5) = rec(5) - total(i)
                    rec(6) = "not active"
                    rec.Update
                    rec.Close
                    Else
                    rec.Close
                End If
            End If
            End If
            FrmMain.MSFlexGrid.TextMatrix(i, 3) = setBebas
          End If
        
    Next i
    Call CekRekap
    Call updateon
End Sub
Public Sub pindahcl()
For i = 1 To ClientMax
        If FrmMain.MSFlexGrid.TextMatrix(i, 3) = "pindah" Then
            rec.Open "SELECT aktifitas.* FROM aktifitas WHERE aktifitas.no_client = " & i, conn, adOpenStatic, adLockOptimistic
            If Not rec.RecordCount = 0 Then
                mulai(i) = rec(4)
                 FrmMain.MSFlexGrid.TextMatrix(i, 10) = rec(5)
                If mulai(i) >= mulai_disc Then
                    disc_mulai(i) = mulai(i)
                Else
                    disc_mulai(i) = mulai_disc
                End If
            End If
            rec.Close
            FrmMain.MSFlexGrid.TextMatrix(i, 4) = Format(mulai(i), "hh:nn:ss")
            FrmMain.MSFlexGrid.TextMatrix(i, 3) = setAktif
        End If
    Next i
End Sub
Public Sub CekRekap()
On Error GoTo hell
Dim total As Single
    Dim tgl As String
    Dim bln As String
    Dim thn As String
    Dim sql As String
    If FrmMain.TxtBulan.Text = "Januari" Then
        bln = "01"
    ElseIf FrmMain.TxtBulan.Text = "Februari" Then
       bln = "02"
    ElseIf FrmMain.TxtBulan.Text = "Maret" Then
        bln = "03"
    ElseIf FrmMain.TxtBulan.Text = "April" Then
        bln = "04"
    ElseIf FrmMain.TxtBulan.Text = "Mei" Then
        bln = "05"
    ElseIf FrmMain.TxtBulan.Text = "Juni" Then
        bln = "06"
    ElseIf FrmMain.TxtBulan.Text = "Juli" Then
        bln = "07"
    ElseIf FrmMain.TxtBulan.Text = "Agustus" Then
        bln = "08"
    ElseIf FrmMain.TxtBulan.Text = "September" Then
        bln = "09"
    ElseIf FrmMain.TxtBulan.Text = "Oktober" Then
        bln = "10"
    ElseIf FrmMain.TxtBulan.Text = "November" Then
        bln = "11"
    ElseIf FrmMain.TxtBulan.Text = "Desember" Then
        bln = "12"
    End If
    tgl = FrmMain.TxtTgl.Text
    thn = FrmMain.TxtTahun.Text
    total = 0
    If FrmMain.OpHari.value = True Then
        If FrmMain.OpSemua.value = True Then
            sql = "SELECT status.* FROM status WHERE status.tanggal = '" & tgl & "-" & bln & "-" & thn & "'"
        Else
            sql = "SELECT status.* FROM status WHERE status.tanggal = '" & tgl & "-" & bln & "-" & thn & "'"
        End If
    Else
        sql = "SELECT status.* FROM status WHERE status.tanggal = '" & tgl & "-" & bln & "-" & thn & "'"
    End If
    rec.Open sql, conn, adOpenStatic, adLockOptimistic
    If Not rec.RecordCount = 0 Then
        FrmMain.GridStatusBayar.Rows = rec.RecordCount + 1
        rec.MoveFirst
        For i = 1 To rec.RecordCount
            FrmMain.GridStatusBayar.TextMatrix(i, 0) = rec(0) 'no nota
            FrmMain.GridStatusBayar.TextMatrix(i, 1) = rec(1) ' tanggal
            FrmMain.GridStatusBayar.TextMatrix(i, 2) = rec(2)  ' no client
            FrmMain.GridStatusBayar.TextMatrix(i, 3) = rec(3) 'nama user
            FrmMain.GridStatusBayar.TextMatrix(i, 4) = rec(10) 'mulai
            FrmMain.GridStatusBayar.TextMatrix(i, 5) = rec(4) 'mulai
            FrmMain.GridStatusBayar.TextMatrix(i, 6) = rec(5) 'selesai
            FrmMain.GridStatusBayar.TextMatrix(i, 7) = rec(6) ' durasi
            FrmMain.GridStatusBayar.TextMatrix(i, 8) = rec(7) ' total
            FrmMain.GridStatusBayar.TextMatrix(i, 9) = rec(11)
            FrmMain.GridStatusBayar.TextMatrix(i, 10) = rec(12)
            total = total + rec(7)
            rec.MoveNext
        Next i
    Else
        FrmMain.GridStatusBayar.Rows = 1
    End If
            rec.Close
IfNoErr:
Exit Sub
hell:
If Err.Number = -2147467259 Then
MsgBox "Service MySql terhenti, hidupkan service dan jalankan program kembali", vbCritical, "MySQL Has Gone Away"
End
ElseIf Err.Number = -2147467259 Then
MsgBox "Lost Connection to MySql, Start MySql and run the program again.", vbCritical, "MySQL Has Gone Away"
End
On Error Resume Next
Else
 'MsgBox "An Error In " & Me.Name & ". See Error.log for detail", vbCritical, "Error Handling"
 TulisError Err.Description, Err.Number, "CekRekap", "Set Module"
 Resume IfNoErr
End If
End Sub

Public Sub updateon()
rec.Open "Select aktifitas .* from aktifitas where aktifitas.status ='" & "aktif" & "'", conn, adOpenStatic, adLockOptimistic
If rec.RecordCount = 0 Then
FrmMain.lblaktif.Forecolor = vbRed
FrmMain.lblaktif.Caption = "No Activity???" & " Whats Going On??"
rec.Close
Else
FrmMain.lblaktif.Caption = "Active Client: " & rec.RecordCount
rec.Close
End If
End Sub
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = 0
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = ""
    End If
End Function
